home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / _PD_TOOLS_ELLI.pdrx < prev    next >
Text File  |  1992-06-15  |  1KB  |  63 lines
  1. /*
  2. ELLIPSE TOOL
  3.  
  4. Modifiers:
  5.     ALT will constrain the ellipse to a circle
  6.     Double Clicking will bring up a requester which allows you to set
  7.     the dimensions of the ellipse
  8. */
  9.  
  10. msg = PDSetup.rexx(2)
  11. units = getclip(pds_units)
  12. if msg ~= 1 then exit_msg(msg)
  13.  
  14. cr = '0a'x
  15. width = getclip(pduserelliwidth)
  16. height = getclip(pduserelliheight)
  17.  
  18. if units > 2 then
  19. do
  20.     width = pdm_ConvertUnits(1, units, width)
  21.     height = pdm_ConvertUnits(1, units, height)
  22. end
  23.  
  24. size = pdm_GetForm("Enter size of ellipse", 8, "Width:"width || cr"Height:"height)
  25. if size = '' then exit_msg()
  26.  
  27. parse var size width '0a'x height
  28.  
  29. if ~(datatype(width, n) & datatype(height,n)) | width <= 0 | height <= 0 then
  30.     exit_msg("Invalid Entry")
  31.  
  32. if units > 2 then
  33. do
  34.     width = pdm_ConvertUnits(units, 1, width)
  35.     height = pdm_ConvertUnits(units, 1, height)
  36. end
  37.  
  38. call setclip(pduserelliwidth, width)
  39. call setclip(pduserelliheight, height)
  40.  
  41. xrad = width / 2
  42. yrad = height / 2
  43.  
  44. rect = pdm_ClickEllipse("Click", xrad, yrad)
  45. if rect = '' then exit_msg()
  46.  
  47. left = word(rect, 1)
  48. top = word(rect, 2)
  49.  
  50. call pdm_DrawEllipse(left, top, xrad, yrad)
  51.  
  52. exit_msg()
  53.  
  54. exit_msg: procedure expose units
  55. do
  56.     parse arg message
  57.  
  58.     if message ~= '' then call pdm_Inform(1,message,)
  59.     call pdm_SetUnits(units)
  60.     call pdm_AutoUpdate(1)
  61.     exit
  62. end
  63.